home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue40 / Alfresco / AAByteQ.pas next >
Encoding:
Pascal/Delphi Source File  |  1998-10-31  |  4.7 KB  |  172 lines
  1. {*********************************************************}
  2. {* AAByteQ                                               *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Queue of bytes class                                  *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AAByteQ;
  14.  
  15. interface
  16.  
  17. uses
  18.   SysUtils,
  19.   Windows;
  20.  
  21. type
  22.   TaaByteQueue = class
  23.     private
  24.       bqHead      : PChar;
  25.       bqTail      : PChar;
  26.       bqQMidPoint : PChar;
  27.       bqQueue     : PChar;
  28.       bqQueueEnd  : PChar;
  29.     protected
  30.       function getCapacity : integer;
  31.       function getCount : integer;
  32.       procedure setCapacity(aValue : integer);
  33.     public
  34.       constructor Create;
  35.       destructor Destroy; override;
  36.  
  37.       procedure Clear;
  38.       procedure Get(var aData; aDataLen : integer);
  39.       function IsEmpty : boolean;
  40.       procedure Put(var aData; aDataLen : integer);
  41.       function Peek(aDataLen : integer) : pointer;
  42.  
  43.       property Capacity : integer
  44.          read getCapacity write setCapacity;
  45.       property Count : integer
  46.          read getCount;
  47.   end;
  48.  
  49. implementation
  50.  
  51. {===Helper routines==================================================}
  52. procedure NotEnoughDataError(aAvail, aReq : integer);
  53. begin
  54.   raise Exception.Create(
  55.           Format('Not enough data in queue (%s bytes) to satisfy read request (%s bytes)',
  56.                  [aAvail, aReq]));
  57. end;
  58. {====================================================================}
  59.  
  60. {===TaaByteQueue=====================================================}
  61. constructor TaaByteQueue.Create;
  62. begin
  63.   inherited Create;
  64.   Capacity := 64;
  65. end;
  66. {--------}
  67. destructor TaaByteQueue.Destroy;
  68. begin
  69.   if Assigned(bqQueue) then
  70.     FreeMem(bqQueue, bqQueueEnd - bqQueue);
  71.   inherited Destroy;
  72. end;
  73. {--------}
  74. procedure TaaByteQueue.Clear;
  75. begin
  76.   bqHead := bqQueue;
  77.   bqTail := bqQueue;
  78. end;
  79. {--------}
  80. procedure TaaByteQueue.Get(var aData; aDataLen : integer);
  81. var
  82.   ByteCount : integer;
  83. begin
  84.   {check for enough data}
  85.   if (aDataLen > Count) then
  86.     NotEnoughDataError(Count, aDataLen);
  87.   {move the data}
  88.   Move(bqHead^, aData, aDataLen);
  89.   inc(bqHead, aDataLen);
  90.   {if we've emptied the queue, move the head/tail pointers back}
  91.   ByteCount := Count;
  92.   if (ByteCount = 0) then begin
  93.     bqHead := bqQueue;
  94.     bqTail := bqQueue;
  95.   end
  96.   {if the head of the queue has moved into the overflow zone, move the
  97.    data back, and reset the head/tail pointers}
  98.   else if (bqHead >= bqQMidPoint) then begin
  99.     Move(bqHead^, bqQueue^, ByteCount);
  100.     bqHead := bqQueue;
  101.     bqTail := bqHead + ByteCount;
  102.   end;
  103. end;
  104. {--------}
  105. function TaaByteQueue.getCapacity : integer;
  106. begin
  107.   Result := (bqQueueEnd - bqQueue) div 2;
  108. end;
  109. {--------}
  110. function TaaByteQueue.getCount : integer;
  111. begin
  112.   Result := bqTail - bqHead;
  113. end;
  114. {--------}
  115. function TaaByteQueue.IsEmpty : boolean;
  116. begin
  117.   Result := bqHead = bqTail;
  118. end;
  119. {--------}
  120. procedure TaaByteQueue.Put(var aData; aDataLen : integer);
  121. var
  122.   ByteCount : integer;
  123. begin
  124.   {if required, grow the queue by at least doubling its size}
  125.   ByteCount := Count;
  126.   while (ByteCount + aDataLen > Capacity) do
  127.     Capacity := Capacity * 2;
  128.   {we now have enough room, so add the new data}
  129.   Move(aData, bqTail^, aDataLen);
  130.   inc(bqTail, aDataLen);
  131. end;
  132. {--------}
  133. function TaaByteQueue.Peek(aDataLen : integer) : pointer;
  134. begin
  135.   {check for enough data}
  136.   if (aDataLen > Count) then
  137.     NotEnoughDataError(Count, aDataLen);
  138.   {just return the head pointer}
  139.   Result := bqHead;
  140. end;
  141. {--------}
  142. procedure TaaByteQueue.setCapacity(aValue : integer);
  143. var
  144.   ByteCount : integer;
  145.   NewQueue  : PChar;
  146. begin
  147.   {don't allow data to be lost}
  148.   ByteCount := Count;
  149.   if (aValue < ByteCount) then
  150.     aValue := ByteCount;
  151.   {round the requested capacity to nearest 64 bytes}
  152.   aValue := (aValue + 63) and $7FFFFFC0;
  153.   {get a new buffer}
  154.   GetMem(NewQueue, aValue * 2);
  155.   {if we have data to transfer from the old buffer, do so}
  156.   if (ByteCount <> 0) then
  157.     Move(bqHead^, NewQueue^, ByteCount);
  158.   {destroy the old buffer}
  159.   if (bqQueue <> nil) then
  160.     FreeMem(bqQueue, bqQueueEnd - bqQueue);
  161.   {set the head/tail and other pointers}
  162.   bqQueue := NewQueue;
  163.   bqHead := NewQueue;
  164.   bqTail := NewQueue + ByteCount;
  165.   bqQueueEnd := NewQueue + (aValue * 2);
  166.   bqQMidPoint := NewQueue + aValue;
  167. end;
  168. {====================================================================}
  169.  
  170. end.
  171.  
  172.